home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / Wirth / Kurven / Hilbert.mod < prev    next >
Text File  |  1993-08-15  |  2KB  |  75 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       Hilbert
  3.   :Author.        Kai Bolay
  4.   :Address.       Hoffmannstraße 168, 7250 Leonberg
  5.   :Phone.         07152/22135
  6.   :History.       v1.00 Initial
  7.   :Copyright.     PD
  8.   :Language.      Modula-2
  9.   :Translator.    M2Amiga 3.2d
  10.   :Contents.      Draws Hilbert...
  11. ------------------------------------------------------------------------- *)
  12. MODULE Hilbert;
  13.  
  14. FROM Dos         IMPORT Delay;
  15. FROM LineDrawing IMPORT SetXY, Line, width, height;
  16.  
  17. VAR i, u, x0, y0      : INTEGER;
  18.     ciapra [0BFE001H] : SET OF (s0, s1, s2, s3, s4, s5, lmb); (* Mouse *)
  19.  
  20. PROCEDURE A (i : INTEGER); FORWARD;
  21. PROCEDURE B (i : INTEGER); FORWARD;
  22. PROCEDURE C (i : INTEGER); FORWARD;
  23. PROCEDURE D (i : INTEGER); FORWARD;
  24.  
  25. PROCEDURE A (i : INTEGER);
  26.  
  27. BEGIN
  28.    IF i > 0 THEN
  29.       D (i-1); Line (4, u); A (i-1); Line (6, u);
  30.       A (i-1); Line (0, u); B (i-1);
  31.    END; (* IF *)
  32. END A;
  33.  
  34.  
  35. PROCEDURE B (i : INTEGER);
  36.  
  37. BEGIN
  38.    IF i > 0 THEN
  39.       C (i-1); Line (2, u); B (i-1); Line (0, u);
  40.       B (i-1); Line (6, u); A (i-1);
  41.    END; (* IF *)
  42. END B;
  43.  
  44.  
  45. PROCEDURE C (i : INTEGER);
  46.  
  47. BEGIN
  48.    IF i > 0 THEN
  49.       B (i-1); Line (0, u); C (i-1); Line (2, u);
  50.       C (i-1); Line (4, u); D (i-1);
  51.    END; (* IF *)
  52. END C;
  53.  
  54.  
  55. PROCEDURE D (i : INTEGER);
  56.  
  57. BEGIN
  58.    IF i > 0 THEN
  59.       A (i-1); Line (6, u); D (i-1); Line (4, u);
  60.       D (i-1); Line (2, u); C (i-1);
  61.    END; (* IF *)
  62. END D;
  63.  
  64. BEGIN
  65.    x0 := width DIV 2; y0 := height DIV 2;
  66.    u := (height DIV 80) * 64;
  67.    FOR i := 1 TO 5 DO
  68.       u := u DIV 2;
  69.       x0 := x0 + (u DIV 2); y0 := y0 + (u DIV 2);
  70.       SetXY (x0, y0);
  71.       A (i);
  72.       WHILE lmb IN ciapra DO Delay (10); END;
  73.    END; (* FOR *)
  74. END Hilbert.
  75.